Test des indicateurs HET

Indicateurs Champagne Ardennes

L’ORUCA a retenu 5 indicateurs:

• HET1: disponibilité en lit (source manuelle ou ROR)
• HET2: Le nombre de passages aux urgences à J-1
• HET3: moyenne des durées de passage des patients hospitalisés à partir des urgences J-1
• HET4: taux d’hospitalisation après passage aux urgences (nb d’hospitalisation / nb de passages) J-1
• HET5: charge d’occupation à 15 heures / capacité d’accueil du service des urgences (nb de patients pouvant être installés simultanément dans le service en salle d’examen et en zone d’attente organisée)

fichier <- "../../DATA/data_test.Rda"
load(fichier) # dx

library(lubridate)
library(xts)

## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

library(Rpu2)

## Loading required package: xtable
## Loading required package: openintro
## Please visit openintro.org for free statistics materials
## 
## Attaching package: 'openintro'
## 
## The following object is masked from 'package:datasets':
## 
##     cars
## 
## Loading required package: plotrix

source("duree_passage.R") # si console: source("Indicateurs/duree_passage.R")

HET2 - Nombre de passages aux urgences (par jour)

n.rpu.jour <- tapply(as.Date(dx$ENTREE), day(as.Date(dx$ENTREE)), length)

# transformation en time serie
x <- seq(min(as.Date(dx$ENTREE)), max(as.Date(dx$ENTREE)), 1)
ts.het2 <- xts(n.rpu.jour, order.by = x)
colnames(ts.het2) <- "HET2"

head(ts.het2)

##            HET2
## 2015-10-01 1391
## 2015-10-02 1441
## 2015-10-03 1580
## 2015-10-04 1417
## 2015-10-05 1613
## 2015-10-06 1453

plot(ts.het2)

# Répartition normale ?
summary(n.rpu.jour)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1070    1325    1373    1384    1451    1613

sd(n.rpu.jour)

## [1] 116.6402

hist(n.rpu.jour)

Graphe avec les WE: on utilise zoo car abline ne fonctionne pas avec xts ?

we <- x[wday(x) %in% c(1,7)]
plot(zoo(ts.het2))
abline(v = as.Date(we), lty = 2, col = "red")

HET3: moyenne des durées de passage des patients hospitalisés à partir des urgences

# sélectionne les enregistrements où le MODE_SORTIE correspond à une hospitalisation 
hosp <- dx[!is.na(dx$MODE_SORTIE) & dx$MODE_SORTIE %in% c("Mutation", "Transfert"), ]

# durée de passage si hospitalisation
dp <- df.duree.pas(hosp, unit = "mins", mintime = 0, maxtime = 3)

# moyenne quotidienne
mean.dp <- tapply(dp$duree , day(as.Date(dp$ENTREE)), mean)

# transformation en time serie
ts.mean.dp <- xts(mean.dp, x)
colnames(ts.mean.dp) <- "HET3"

par(mar = c(2,4,2,5))
plot(ts, ylab = "Nombre de passages")
par(new=TRUE)
plot(ts.mean.dp, xaxt="n",xlab="",ylab="", main = "", yaxt="n", lty = 2)
axis(4)
mtext("Durée moyenne de passage (mn)",side=4,line=3, col = "blue")

HET4: taux d’hospitalisation après passage aux urgences (nb d’hospitalisation / nb de passages)

n.hosp.jour <- tapply(as.Date(hosp$ENTREE), day(as.Date(hosp$ENTREE)), length)
tx.hosp <- n.hosp.jour / n.rpu.jour
ts.tx.hosp <- xts(tx.hosp, x)
colnames(ts.tx.hosp) <- "HET4"
plot(ts.tx.hosp)

HET5 - charge d’occupation à 15 heures / capacité d’accueil du service des urgences

dp$present.a.15h <- is.present.at(dp)
# nombre moyen de patients présents à 15h tous les jours
n.p15 <- tapply(dp$present.a.15h, yday(as.Date(dp$ENTREE)), sum)

# Transformation en TS
ts.n.p15 <- xts(n.p15, x)
colnames(ts.n.p15) <- "HET5"
plot(ts.n.p15, main = "Nombre de patients présents au SU à 15 heures")

Synthèse

a <- cbind(ts.het2, ts.mean.dp, ts.tx.hosp, ts.n.p15)
head(a)

##            HET2     HET3      HET4 HET5
## 2015-10-01 1391 276.0884 0.1552840   73
## 2015-10-02 1441 251.7166 0.1734906   77
## 2015-10-03 1580 263.7952 0.1360759   80
## 2015-10-04 1417 226.6344 0.1362032   52
## 2015-10-05 1613 285.2227 0.1487911   91
## 2015-10-06 1453 246.2511 0.1631108   80

a[1, ]

##            HET2     HET3     HET4 HET5
## 2015-10-01 1391 276.0884 0.155284   73

#radial.plot(a[1, ], labels=ion.names,rp.type="p",main="Diagramme indicateurs HET", grid.unit="%",radial.lim=c(0, 5),poly.col="yellow",show.grid.labels=1)

Corrélation taux hospitalisation et nombre de passages, et durée de passage

# corrélation entre la durée moyenne de passage quotidienne et le nombre de présents à 15h
plot(mean.dp, n.p15, main = "Corrélation durée moyenne de passage quotidienne\n et le nombre de présents à 15h", col ="black", pch = 15)
cor(mean.dp, n.p15)

## [1] 0.5050714

y <- lm(mean.dp ~ n.p15)
y

## 
## Call:
## lm(formula = mean.dp ~ n.p15)
## 
## Coefficients:
## (Intercept)        n.p15  
##    195.0130       0.7528

summary(y)

## 
## Call:
## lm(formula = mean.dp ~ n.p15)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -22.221  -8.760  -3.053   6.692  38.822 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 195.0130    16.9535  11.503 2.51e-12 ***
## n.p15         0.7528     0.2389   3.151  0.00376 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 14.22 on 29 degrees of freedom
## Multiple R-squared:  0.2551, Adjusted R-squared:  0.2294 
## F-statistic: 9.931 on 1 and 29 DF,  p-value: 0.003756

abline(y)

# corrélation entre la duréee moyenne de passage et le nombre total de passages
cor(mean.dp, n.rpu.jour)

## [1] 0.02616335

# corrélation entre taux hospitalisation et nombre de passages
cor(tx.hosp, n.rpu.jour)

## [1] -0.6936409

y <- lm(n.rpu.jour ~ tx.hosp)
y

## 
## Call:
## lm(formula = n.rpu.jour ~ tx.hosp)
## 
## Coefficients:
## (Intercept)      tx.hosp  
##        2144        -4719

summary(y)

## 
## Call:
## lm(formula = n.rpu.jour ~ tx.hosp)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -160.602  -52.294   -2.761   51.225  171.601 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2143.6      147.3  14.550 7.35e-15 ***
## tx.hosp      -4719.3      910.1  -5.186 1.51e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 85.45 on 29 degrees of freedom
## Multiple R-squared:  0.4811, Adjusted R-squared:  0.4632 
## F-statistic: 26.89 on 1 and 29 DF,  p-value: 1.514e-05

plot(tx.hosp, n.rpu.jour, col ="black", pch = 15)
abline(y)

Radar

source("../het.R")

a <- cbind(0, ts.het2, ts.mean.dp, ts.tx.hosp, ts.n.p15)
head(a)

##            X0 HET2     HET3      HET4 HET5
## 2015-10-01  0 1391 276.0884 0.1552840   73
## 2015-10-02  0 1441 251.7166 0.1734906   77
## 2015-10-03  0 1580 263.7952 0.1360759   80
## 2015-10-04  0 1417 226.6344 0.1362032   52
## 2015-10-05  0 1613 285.2227 0.1487911   91
## 2015-10-06  0 1453 246.2511 0.1631108   80

a[1, ]

##            X0 HET2     HET3     HET4 HET5
## 2015-10-01  0 1391 276.0884 0.155284   73

# normalisation sous forme de variable centréée et réduite. Par défaut, moyenne et sd sont calculés à partir de l'échantillon de départ.
m <- 5
a[, 1] <- m 
a[, 2] <- m + (a[, 2] - mean(n.rpu.jour)) / sd(n.rpu.jour)
a[, 3] <- m +  (a[, 3] - mean(mean.dp)) / sd(mean.dp)
a[, 4] <- m +  (a[, 4] - mean(tx.hosp)) / sd(tx.hosp)
a[, 5] <- m +  (a[, 5] - mean(n.p15)) / sd(n.p15)

# indicateurs pour le mois d'octobre 2015
for(i in 1:31){
    radar.het(a[i,])
}